home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / mtcnv / mtcnv45a.bas next >
BASIC Source File  |  1993-11-30  |  10KB  |  222 lines
  1. 100 '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
  2. 110 '
  3. 120 '        ＭＳＸ→ＴＯＷＮＳ　グラフィック コンバーター  Ver 4.5a
  4. 130 '                    BSAVE形式→TIFF形式
  5. 140 '                       (FILES版)         Programed by YAZ
  6. 150 '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
  7. 1000 CLEAR ,,,70000:SCREEN@ 0:COLOR 7,0,7,0:PALETTE:CONSOLE 0,24,2
  8. 1010 DEFINT A-Z:DEFLNG F,M:DIM GRPDAT(255),IMA(27136),C(3,2),PALDAT(47)
  9. 1020 M_ADJ=VARPTR(GRPDAT(0))
  10. 1030 *INIT  '=============================================================
  11. 1040 SCREEN@ 0:CLS:PALETTE
  12. 1050 FOR I=0 TO 255:GRPDAT(I)=0:NEXT:DR$="":WILD$="":SDR$=""
  13. 1060 PRINT "読み込むドライブ ( DRV:A-Q  END:@ ) :";:DR$=INPUT$(1):PRINT DR$
  14. 1070 IF (DR$<"@" OR "Q"<DR$) AND (DR$<"a" OR "q"<DR$) THEN 1060
  15. 1080 IF DR$="@" THEN END
  16. 1090 INPUT "ワイルドカード :",WILD$
  17. 1100 IF WILD$="" THEN WILD$=DR$+":*.*" ELSE WILD$=DR$+":"+WILD$
  18. 1110 ON ERROR GOTO *ERR_TRAP1
  19. 1120 FILES WILD$
  20. 1130 ON ERROR GOTO 0
  21. 1140 INPUT"ファイルネーム : ";NME$
  22. 1150 IF NME$="" OR INSTR(NME$," ") THEN 1140
  23. 1160 PRINT "スクリーンモード ( 1:SCREEN_5  2:SCREEN_6  3:SCREEN_7  4:SCREEN_8  5:19268色 )":PRINT ": ";
  24. 1170 A$=INPUT$(1):PRINT A$
  25. 1180 IF A$<"1" OR "5"<A$ THEN 1160
  26. 1190   IF A$="1" THEN SCRMODE=1:REP=256/2:S_SIZE=1
  27. 1200   IF A$="2" THEN SCRMODE=2
  28. 1210   IF A$="3" THEN SCRMODE=3:REP=512/2:S_SIZE=2
  29. 1220   IF A$="4" THEN SCRMODE=4
  30. 1230   IF A$="5" THEN SCRMODE=5
  31. 1240 PRINT "保存するドライブ ( A-P ) :";:SDR$=INPUT$(1):PRINT SDR$
  32. 1250 IF (SDR$<"A" OR "P"<SDR$) AND (SDR$<"a" OR "p"<SDR$) THEN 1240
  33. 1260 PRINT "全てよろしいですか？ ( Y/N ) : ";:A$=INPUT$(1):PRINT A$
  34. 1270 IF A$="N" OR A$="n" THEN *INIT ELSE IF A$<>"Y" AND A$<>"y" THEN 1260
  35. 1280 *CONV  '=============================================================
  36. 1290 ON ERROR GOTO *ERR_TRAP1
  37. 1300 OPEN "I",#1,DR$+":"+NME$
  38. 1310 ON ERROR GOTO 0
  39. 1320 F_MOD=ASC(INPUT$(1,#1))
  40. 1330 IF F_MOD<>254 THEN PRINT "ＢＳＡＶＥ形式ではありません":CLOSE #1:BEEP:       WAIT 80:GOTO *INIT
  41. 1340 F_STA=ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))*256
  42. 1350 F_BTM=ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))*256
  43. 1360 S$=INPUT$(2,#1)
  44. 1370 CLS:ON SCRMODE GOSUB *SCR_5･7,*SCR_6,*SCR_5･7,*SCR_8,*SCR_12
  45. 1380 *SAVE  '=============================================================
  46. 1390 X=0:Y=0:MOUSE 0:MOUSE 1,,,1
  47. 1400 MOUSE 4,0,0,639+(SCRMODE=5)*320,479+(SCRMODE=5)*240
  48. 1410 LOCATE 66,21
  49. 1420 IF P_SCH=0 THEN PRINT "PALETTE OFF"; ELSE PRINT "PALETTE ON ";
  50. 1430 IF SCRMODE=2 OR SCRMODE=3 THEN SX=511:SY=423 ELSE SX=255:SY=211
  51. 1440 LOCATE 66,16:PRINT "[ESC]=中止"
  52. 1450 LOCATE 67,18:PRINT USING"X=###   Y=###";X;Y;
  53. 1460 LOCATE 66,19:PRINT USING"SX=###  SY=###";SX;SY;
  54. 1470 LINE (X,Y)-(SX,SY),XOR,7,B
  55. 1480 CIRCLE (X,Y),5,7,,,,,XOR:CIRCLE (SX,SY),5,7,,,,,XOR
  56. 1490 XX=X:YY=Y:SXX=SX:SYY=SY
  57. 1500  A$=INKEY$
  58. 1510  IF NOT(A$=CHR$(27) OR A$=CHR$(13) OR A$=" " OR MOUSE(2,0)) THEN 1500
  59. 1520  IF MOUSE(2,0)=0 THEN 1670
  60. 1530   DX=MOUSE(4,0):DY=MOUSE(5,0)
  61. 1540   IF ABS(DX-X)>5 OR ABS(DY-Y)>5 THEN 1600
  62. 1550    MOUSE 4,0,0,SX-8,SY-8
  63. 1560    WHILE MOUSE(2,0)
  64. 1570     X=MOUSE(0):Y=MOUSE(1)
  65. 1580     IF X<>XX OR Y<>YY THEN GOSUB *SAVE_SUB
  66. 1590    WEND:GOTO 1660
  67. 1600   IF ABS(DX-SX)>5 OR ABS(DY-SY)>5 THEN 1670
  68. 1610    MOUSE 4,X+8,Y+8,639+(SCRMODE=5)*320,479+(SCRMODE=5)*240
  69. 1620    WHILE MOUSE(2,0)
  70. 1630     SX=MOUSE(0):SY=MOUSE(1)
  71. 1640     IF SX<>SXX OR SY<>SYY THEN GOSUB *SAVE_SUB
  72. 1650    WEND
  73. 1660   MOUSE 4,0,0,639+(SCRMODE=5)*320,479+(SCRMODE=5)*240
  74. 1670  IF A$=CHR$(27) THEN MOUSE 5:GOTO *INIT
  75. 1680  IF A$<>" " OR SCRMODE>3 THEN 1740
  76. 1690  LOCATE 66,21
  77. 1700  IF P_SCH<>0 THEN PRINT "PALETTE OFF";:PALETTE:P_SCH=0:GOTO 1740
  78. 1710   FOR J=0 TO 15+(SCRMODE=2)*12
  79. 1720   PALETTE J,[PALDAT(J*3),PALDAT(J*3+1),PALDAT(J*3+2)]
  80. 1730   NEXT:P_SCH=1:PRINT "PALETTE ON ";
  81. 1740  IF A$<>CHR$(13) THEN 1500 ELSE MOUSE 5
  82. 1750 CIRCLE (X,Y),5,7,,,,,XOR:CIRCLE (SX,SY),5,7,,,,,XOR
  83. 1760 LINE (X,Y)-(SX,SY),XOR,7,B
  84. 1770 ON ERROR GOTO *ERR_TRAP2
  85. 1780 SAVE@ SDR$+":"+LEFT$(NME$,INSTR(NME$,"."))+"TIF",(X,Y)-(SX,SY),P_SCH
  86. 1790 ON ERROR GOTO 0:GOTO *INIT
  87. 1800 *SAVE_SUB '=================
  88. 1810 MOUSE 1,,,0
  89. 1820 CIRCLE (XX,YY),5,7,,,,,XOR:CIRCLE (SXX,SYY),5,7,,,,,XOR
  90. 1830 CIRCLE (X,Y),5,7,,,,,XOR:CIRCLE (SX,SY),5,7,,,,,XOR
  91. 1840 LINE (XX,YY)-(SXX,SYY),XOR,7,B:LINE (X,Y)-(SX,SY),XOR,7,B
  92. 1850 MOUSE 1,,,1:XX=X:YY=Y:SXX=SX:SYY=SY
  93. 1860 LOCATE 67,18:PRINT USING"X=###   Y=###";X;Y;
  94. 1870 LOCATE 66,19:PRINT USING"SX=###  SY=###";SX;SY;
  95. 1880 RETURN
  96. 1890 *SCR_5･7  '==========================================================
  97. 1900 LOCATE 66,16:PRINT "[ESC]=中止"
  98. 1910 Y=0:ES=0:F_ADJ=F_STA MOD REP:F_ADR=F_STA-F_ADJ
  99. 1920 IF F_ADJ<>0 THEN S$=STRING$(F_ADJ-1,0)+INPUT$(REP-F_ADJ,#1) ELSE 2000
  100. 1930  FOR J=1 TO REP-1
  101. 1940   AS=ASC(MID$(S$,J,1))
  102. 1950   POKE M_ADJ+J,AS \16+(AS AND 15)*16
  103. 1960  NEXT
  104. 1970 POKE M_ADJ,0
  105. 1980 PUT@A (0,0)-(REP*2-1,0),GRPDAT,,,S_SIZE
  106. 1990 Y=Y+1
  107. 2000 WHILE F_ADR<F_BTM AND ES=0
  108. 2010  IF INKEY$=CHR$(27) THEN ES=-1:GOTO 2120
  109. 2020  IF F_BTM-F_ADR>=REP THEN S$=INPUT$(REP-1,#1):S1$=INPUT$(1,#1) ELSE           S$=INPUT$(F_BTM-F_ADR,#1):S$=S$+STRING$(REP-1-LEN(S$),0):S1$=CHR$(0)
  110. 2030  FOR J=1 TO REP-1
  111. 2040   AS=ASC(MID$(S$,J,1))
  112. 2050   POKE M_ADJ+J-1,AS \16+(AS AND 15)*16
  113. 2060  NEXT
  114. 2070  AS=ASC(S1$)
  115. 2080  POKE M_ADJ+REP-1,AS \16+(AS AND 15)*16
  116. 2090  PUT@A (0,Y*S_SIZE)-(REP*2-1,Y*S_SIZE),GRPDAT,,,S_SIZE
  117. 2100  IF F_ADR=&H7680-33664*(SCRMODE=3) THEN GOSUB *GET_PAL
  118. 2110  Y=Y+1:F_ADR=F_STA-F_ADJ+REP*Y
  119. 2120 WEND:CLOSE
  120. 2130 IF ES=-1 THEN LOCATE 66,16:PRINT "中止します。":WAIT 80:RETURN *INIT
  121. 2140 RETURN
  122. 2150 *SCR_6  '============================================================
  123. 2160 LOCATE 66,16:PRINT "[ESC]=中止"
  124. 2170 Y=0:ES=0:F_ADJ=F_STA MOD 128:F_ADR=F_STA-F_ADJ
  125. 2180 IF F_ADJ<>0 THEN S$=STRING$(F_ADJ-1,0)+INPUT$(128-F_ADJ,#1) ELSE 2270
  126. 2190  FOR J=1 TO 127
  127. 2200   AS=ASC(MID$(S$,J,1))
  128. 2210   POKE M_ADJ+J*2,AS \64+(AS \16 AND 3)*16
  129. 2220   POKE M_ADJ+J*2+1,(AS \4 AND 3)+(AS AND 3)*16
  130. 2230  NEXT
  131. 2240 POKE M_ADJ,0,2
  132. 2250 PUT@A (0,0)-(511,0),GRPDAT,,,2
  133. 2260 Y=Y+1
  134. 2270 WHILE F_ADR<F_BTM AND ES=0
  135. 2280  IF INKEY$=CHR$(27) THEN ES=-1:GOTO 2380
  136. 2290  IF F_BTM-F_ADR>=128 THEN S$=INPUT$(128,#1) ELSE                              S$=INPUT$(F_BTM-F_ADR,#1):S$=S$+STRING$(128-LEN(S$),0)
  137. 2300  FOR J=1 TO 128
  138. 2310   AS=ASC(MID$(S$,J,1))
  139. 2320   POKE M_ADJ+J*2-2,AS \64+(AS \16 AND 3)*16
  140. 2330   POKE M_ADJ+J*2-1,(AS \4 AND 3)+(AS AND 3)*16
  141. 2340  NEXT
  142. 2350  PUT@A (0,Y*2)-(511,Y*2),GRPDAT,,,2
  143. 2360  IF F_ADR=&H7680 THEN GOSUB *GET_PAL
  144. 2370  Y=Y+1:F_ADR=F_STA-F_ADJ+128*Y
  145. 2380 WEND:CLOSE
  146. 2390 IF ES=-1 THEN LOCATE 66,16:PRINT "中止します。":WAIT 80:RETURN *INIT
  147. 2400 RETURN
  148. 2410 *SCR_8  '============================================================
  149. 2420 SCREEN@ 2:LOCATE 66,16:PRINT "[ESC]=中止"
  150. 2430 Y=0:ES=0:F_ADJ=F_STA MOD 256:F_ADR=F_STA-F_ADJ
  151. 2440 IF F_ADJ<>0 THEN S$=STRING$(F_ADJ-1,0)+INPUT$(256-F_ADJ,#1) ELSE 2510
  152. 2450  FOR J=1 TO 255
  153. 2460   POKE M_ADJ+J,ASC(MID$(S$,J,1))
  154. 2470  NEXT
  155. 2480 POKE M_ADJ,0
  156. 2490 PUT@A (0,0)-(255,0),GRPDAT
  157. 2500 Y=Y+1
  158. 2510 WHILE F_ADR<F_BTM AND ES=0
  159. 2520  IF INKEY$=CHR$(27) THEN ES=-1:GOTO 2600
  160. 2530  IF F_BTM-F_ADR>=256 THEN S$=INPUT$(255,#1):S1$=INPUT$(1,#1) ELSE             S$=INPUT$(F_BTM-F_ADR,#1):S$=S$+STRING$(255-LEN(S$),0):S1$=CHR$(0)
  161. 2540  FOR J=1 TO 255
  162. 2550   POKE M_ADJ+J-1,ASC(MID$(S$,J,1))
  163. 2560  NEXT
  164. 2570  POKE M_ADJ+255,ASC(S1$)
  165. 2580  PUT@A (0,Y)-(255,Y),GRPDAT
  166. 2590  Y=Y+1:F_ADR=F_STA-F_ADJ+256*Y
  167. 2600 WEND:CLOSE
  168. 2610 IF ES=-1 THEN LOCATE 66,16:PRINT "中止します。":WAIT 80:RETURN *INIT
  169. 2620 P_SCH=0:RETURN
  170. 2630 *SCR_12  '===========================================================
  171. 2640 GOSUB *SCR_8
  172. 2650 GET@A (0,0)-(255,211),IMA
  173. 2660 SCREEN@ 1:CLS:LOCATE 66,16:PRINT "[ESC]=中止"
  174. 2670 FOR H=0 TO 211
  175. 2680  IF INKEY$=CHR$(27) THEN H=211:NEXT:LOCATE 66,16:PRINT "中止します。":         WAIT 80:GOTO *INIT
  176. 2690  FOR I=0 TO 126 STEP 2
  177. 2700   FSUB0=IMA(H*128+I) AND 65535
  178. 2710   FSUB1=IMA(H*128+I+1) AND 65535
  179. 2720   Y0=(FSUB0 \ 8)AND 31:Y1=(FSUB0 \ 2048)AND 31
  180. 2730   Y2=(FSUB1 \ 8)AND 31:Y3=(FSUB1 \ 2048)AND 31
  181. 2740   K=((FSUB0 \ 32)AND 56)+(FSUB0 AND 7):K=K+(K>31)*64
  182. 2750   J=((FSUB1 \ 32)AND 56)+(FSUB1 AND 7):J=J+(J>31)*64
  183. 2760   C(0,0)=Y0+K:C(0,1)=Y0+J:C(0,2)=Y0*5\4-J\2-K\4
  184. 2770   C(1,0)=Y1+K:C(1,1)=Y1+J:C(1,2)=Y1*5\4-J\2-K\4
  185. 2780   C(2,0)=Y2+K:C(2,1)=Y2+J:C(2,2)=Y2*5\4-J\2-K\4
  186. 2790   C(3,0)=Y3+K:C(3,1)=Y3+J:C(3,2)=Y3*5\4-J\2-K\4
  187. 2800   FOR L=0 TO 3
  188. 2810    FOR M=0 TO 2
  189. 2820     IF C(L,M)<0 THEN C(L,M)=0
  190. 2830     IF C(L,M)>31 THEN C(L,M)=31
  191. 2840   NEXT:NEXT
  192. 2850   POKE M_ADJ+I*4  ,C(0,0)*1024+C(0,1)*32+C(0,2),2
  193. 2860   POKE M_ADJ+I*4+2,C(1,0)*1024+C(1,1)*32+C(1,2),2
  194. 2870   POKE M_ADJ+I*4+4,C(2,0)*1024+C(2,1)*32+C(2,2),2
  195. 2880   POKE M_ADJ+I*4+6,C(3,0)*1024+C(3,1)*32+C(3,2),2
  196. 2890  NEXT
  197. 2900  PUT@A (0,H)-(255,H),GRPDAT
  198. 2910 NEXT:RETURN
  199. 2920 *GET_PAL  '========================================================
  200. 2930 FOR J=0 TO 15
  201. 2940  PALDAT(J*3)=(ASC(MID$(S$,-(SCRMODE=3)*128+J*2+2)) AND 7)*32
  202. 2950  PALDAT(J*3+1)=(ASC(MID$(S$,-(SCRMODE=3)*128+J*2+1)) AND 112)*2
  203. 2960  PALDAT(J*3+2)=(ASC(MID$(S$,-(SCRMODE=3)*128+J*2+1)) AND 7)*32
  204. 2970  PALETTE J,[PALDAT(J*3),PALDAT(J*3+1),PALDAT(J*3+2)]
  205. 2980 NEXT
  206. 2990 P_SCH=1
  207. 3000 RETURN
  208. 3010 *ERR_TRAP1  '=======================================================
  209. 3020 PRINT "該当ファイルなし":BEEP:WAIT 80:RESUME *INIT
  210. 3030 *ERR_TRAP2  '=======================================================
  211. 3040 LOCATE 0,23
  212. 3050 IF ERR<>64 THEN PRINT "書き込み不可能";:BEEP:WAIT 120:ON ERROR GOTO 0:       LOCATE 0,23:PRINT SPC(60);:RESUME *SAVE
  213. 3060 PRINT "同名のファイルが存在します。上書きしますか？ ( Y/N ) : ";
  214. 3070 LOCATE 55,23:A$=INPUT$(1):PRINT A$;
  215. 3080 IF A$="N" OR A$="n" THEN 3100 ELSE IF A$<>"Y" AND A$<>"y" THEN 3070
  216. 3090 KILL SDR$+":"+LEFT$(NME$,INSTR(NME$,"."))+"TIF":RESUME
  217. 3100 LOCATE 0,23:PRINT SPC(60);:LOCATE 0,22
  218. 3110 INPUT"新しいファイルネームを入力してください : ";NME$
  219. 3111 IF NME$="" OR INSTR(NME$," ") THEN 3110
  220. 3120 NME$=NME$+".":LOCATE 0,22:PRINT SPC(60);:RESUME
  221. 3140 '= BOTTOM ==========================================================
  222.